home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
clipper
/
cgwrka10.zip
/
DEMO.PRG
< prev
next >
Wrap
Text File
|
1994-02-14
|
7KB
|
326 lines
/*****************************************************************
* Copyright (c). All rights reserved.
*
* PROGRAM NAME: DEMO
*
* AUTHOR: BOSTJAN DEBELJAK
*
* DATE: 29 Feb 94
*
* DESCRIPTION: demo ,program for library CG_WORK
*
*****************************************************************/
#include "inkey.ch" /* KEY CODE DEFINITIONS */
#define M0 0 /* ~People */
#define M1 1 /* ~Exit */
#define M0_0 50 /* ~Person */
#define M0_1 51 /* p~Arent */
#define M0_2 52 /* ~Town */
#define M0_3 53 /* ~Car */
#define M1_0 100 /* ~Exit */
/**********/
#define TM0 "~People"
#define TM1 "~Exit"
#define TM0_0 "~Person"
#define TM0_1 "p~Arent"
#define TM0_2 "~Town"
#define TM0_3 "~Car"
#define TM1_0 "~Exit"
/**********/
STATIC hBar, hM0, hM1
/********************/
FUNCTION Main()
LOCAL nChoice, cond_work
PUBLIC ret_person[2]
PUBLIC db_path
db_path := "."
SET DATE TO german
cg_init()
CreateBar()
CLS
BarActivate( hBar )
nChoice := BarMenuChoice( hBar )
cond_work := .t.
DO WHILE cond_work == .t.
DO CASE
CASE nChoice == M0_0 /* ~Person */
person()
CASE nChoice == M0_1 /* p~Arent */
parent()
CASE nChoice == M0_2 /* ~Town */
town()
CASE nChoice == M0_3 /* ~Car */
car()
CASE nChoice == M1_0 /* ~Exit */
cond_work := .f.
OTHERWISE
nChoice := BarMenuChoice( hbar, 1)
ENDCASE
if (cond_work == .t.)
BarActivate( hBar )
nChoice := BarMenuChoice( hBar )
endif
ENDDO
CLS
RETURN NIL
/***
* CreateBar() --> NIL
* This functions creates the menus, grays certain prompts, checks other
* prompts
*
*/
STATIC FUNCTION CreateBar()
// Create empty bar menu
hBar := BarNew()
// Create empty menus
hBar := BarNew()
// Create empty menus
hM0 := MenuNew( TM0 )
hM1 := MenuNew( TM1 )
PromptAdd ( hM0, M0_0, TM0_0)
PromptAdd ( hM0, M0_1, TM0_1)
PromptAdd ( hM0, M0_2, TM0_2)
PromptAdd ( hM0, M0_3, TM0_3)
PromptAdd ( hM1, M1_0, TM1_0)
/**********/
//Add menus to menubar
MenuAdd( hBar, hM0 )
MenuAdd( hBar, hM1 )
RETURN NIL
/*****************************************************************
* FUNCTION NAME:
*
* DESCRIPTION:
*
*****************************************************************/
func car()
cg_work("INP_DEMO", "W_CAR", 25, 5, 70, 14)
RETURN NIL
/*****************************************************************
* FUNCTION NAME:
*
* DESCRIPTION:
*
*****************************************************************/
func parent()
before_query = "set_person"
COMM_U1 = "F1-Help,F2-Query,F3-Next,F4-Prev,F5-Update,F6-Outp,F8-Exit"
COMM_U2 = ""
U_Next := K_F3
U_Prev := K_F4
U_Update := K_F5
U_Output := K_F6
U_Add := NIL
U_Delete := NIL
U_Line := NIL
U_Num := NIL
U_Comm := NIL
before_output = "print_head"
par_bef_out = "2, PARENT"
cg_work("INP_DEMO", "W_PARENT", 5, 5, 75, 20)
RETURN NIL
/*****************************************************************
* FUNCTION NAME:
*
* DESCRIPTION:
*
*****************************************************************/
func person()
before_output = "print_head"
par_bef_out = "1, PERSON"
u_call_F9 = "show_el_no"
COMM_U2 := COMM_U2 + ",F9-El_no"
ret_person = cg_work("INP_DEMO", "W_PERSON", 5, 5, 75, 20)
RETURN NIL
/*****************************************************************
* FUNCTION NAME:
*
* DESCRIPTION:
*
*****************************************************************/
func town()
before_output = "print_head"
par_bef_out = "3, TOWN"
cg_work("INP_DEMO", "W_TOWN", 25, 5, 60, 13)
RETURN NIL
/******************************************************************************/
/********************************************************
* check_car()
* Real (first car element isn't real car) car can own just one person
*
********************************************************/
FUNCTION check_car(i, ii)
local str, cond, line
cond := .t.
if (ins_val[i] != "0")
select car
line := Recno()
goto 1
str := "car->id_no = " + CHR(39) + RTRIM(ins_val[i]) + CHR(39)
locate for &str
car_id := car->c_ind
goto line
select people
line := Recno()
goto 1
str := "people->c_ind = " + LTRIM(STR(car_id))
locate for &str
if (Found())
cond := .f.
endif
goto line
endif
RETURN cond
/********************************************************
* ins_c()
* insert other part of car
*
********************************************************/
FUNCTION ins_c(i)
local str
if (i == 8)
str := FieldName(3) /* TYPE */
ins_val[i + 1] := &str
else
str := FieldName(2) /* NUMBER */
ins_val[i - 1] := &str
endif
RETURN NIL
/********************************************************
* ins_p()
* insert other part of name
*
********************************************************/
FUNCTION ins_p(i)
local str
if (i == 1 .or. i == 3 .or. i == 5)
str := FieldName(3) /* SURNAME */
ins_val[i + 1] := &str
else
str := FieldName(2) /* NAME */
ins_val[i - 1] := &str
endif
RETURN NIL
/********************************************************
* print_head()
* print header on output
*
********************************************************/
FUNCTION print_head(fp, param)
local str_end, line, str[2]
str := ListAsArray(param)
line = CHR(K_TAB) + CHR(K_TAB) + "REPORT" + str[1] + ": " + str[2]
fwrite(fp, line)
str_end = CHR(K_RETURN) + CHR(10)
fwrite(fp, str_end)
fwrite(fp, str_end)
RETURN NIL
/********************************************************
* set_person()
* set person data returned from previous 'cg_work' on submenu PERSON
*
********************************************************/
FUNCTION set_person()
if (ret_person[1] != NIL)
ins_val[1] := ret_person[1]
ins_val[2] := ret_person[2]
endif
RETURN NIL
/********************************************************
* show_el_no()
* get and display current showed element number
*
********************************************************/
FUNCTION show_el_no()
local no, str
no := 1
while (previous_el() == .t.)
/* COUNT ELEMENT NUMBER */
no++
end
str := "Element number is: " + LTRIM(STR(no))
str := str + SPACE(80 - LEN(str))
@ Maxrow(), 0 SAY str
Inkey(5)
for i:= 1 to no-1
/* GO ON DISPLAYED ELEMENT */
next_el()
next
RETURN NIL
/********************************************************
* val_not_futur()
* validate (check) inserted date. Date must not be in future
*
********************************************************/
FUNCTION val_not_futur(i)
local cond
cond := .t.
if (LEN(ins_val[i]) != 0)
if (DATE() < CTOD(ins_val[i]))
cond := .f.
endif
endif
RETURN cond